unit WebApi_Tool;

interface

uses
  DB, SysUtils, Classes, superobject, Rtti;

type
  TJSON<T> = class(TPersistent)
  public
    class function ToObj(json: string): T;
  end;

function Q(s: string): string;

function DSToJArray(ds: TDataSet): string;

function DSToJObject(ds: TDataSet): string;

function CheckType(dbtype: TFieldType): Boolean;

implementation

function Q(s: string): string;
begin
  Result := '''' + s + '''';
end;

function CheckType(dbtype: TFieldType): Boolean;
begin
  if dbtype in [ftString, ftWideString, ftUnknown, ftWideMemo, ftMemo, ftDate, ftDateTime, ftTime, ftFmtMemo, ftTimeStamp, ftTimeStampOffset] then
  begin
    Result := true;
  end
  else
  begin
    Result := false;
  end;
end;

function DSToJArray(ds: TDataSet): string;
var
  k: Integer;
  ret: string;
  ftype: TFieldType;
  json, item, key, value: string;
  aStream: TStringStream;
begin
  ret := '';
  with ds do
  begin
    if IsEmpty or (not Active) then
    begin
      Result := '[]';
      exit;
    end;
    json := '';
    First;

    while not Eof do
    begin
      item := '';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;

        ftype := Fields[k].DataType;

        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + value + '"'
        end
        else if ftype = ftBoolean then
        begin
          value := Fields[k].AsString;
          value := LowerCase(value);
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end
        else if ftype = ftBlob then
        begin
          aStream := TStringStream.Create('', TEncoding.UTF8, True);
          try
            TBlobField(Fields[k]).SaveToStream(aStream);
            aStream.position := 0;
            value := '"' + aStream.DataString + '"';
          finally
            aStream.Free;
          end;
        end
        else
          value := Fields[k].AsString;
        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, Length(item) - 1);
      item := '{' + item + '},';
      json := json + item;
      Next;
    end;
    if Length(json) > 1 then
      json := copy(json, 1, Length(json) - 1);
    json := '[' + json + ']';
    Result := json;
  end;
end;

function DSToJObject(ds: TDataSet): string;
var
  k: Integer;
  ftype: TFieldType;
  json, item, key, value: string;
begin
  json := '';
  with ds do
  begin

    if IsEmpty or (not Active) then
    begin
      Result := '{}';
      exit;
    end;

    if not IsEmpty then
    begin
      item := '{';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;
        value := Fields[k].AsString;
        ftype := Fields[k].DataType;
        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + value + '"'

        end
        else if ftype = ftBoolean then
        begin
          value := LowerCase(value);
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end;

        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, Length(item) - 1);
      item := item + '},';
      json := json + item;
      Next;
    end;
    if Length(json) > 1 then
      json := copy(json, 1, Length(json) - 1);
    Result := json;
  end;
end;

{ TJSON<T> }

class function TJSON<T>.ToObj(json: string): T;
var
  jo: ISuperObject;
  value: T;
  _rtti: TRttiContext;
  tt: TRttiType;
  fields: TArray<TRttiField>;
  field: TRttiField;
  key, ty: string;
begin
  value := Default(T);
  if json <> '' then
  begin
    tt := _rtti.GetType(TypeInfo(T));
    fields := tt.GetFields;
    jo := SO(json);
    for field in fields do
    begin
      key := field.Name;
      ty := field.FieldType.ToString;
      if jo.O[key] <> nil then
      begin
        if ty = 'string' then
          field.SetValue(@value, jo.S[key])
        else if ty = 'integer' then
          field.SetValue(@value, jo.I[key])
        else if ty = 'boolean' then
          field.SetValue(@value, jo.B[key])
        else if Pos('double,float', ty) > -1 then
          field.SetValue(@value, jo.D[key])
      end;
    end;
    Result := value;
  end
  else
    result := value;
end;

end.

